home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / cmsrc392.zip / CMBASE.MF < prev    next >
Text File  |  1992-05-20  |  29KB  |  698 lines
  1. % The base file for Computer Modern (a supplement to {\tt plain.mf})
  2.  
  3. cmbase:=1; % when |cmbase| is known, this file has been input
  4.  
  5. let cmchar=\; % `|cmchar|' should precede each character
  6. let generate=input; % `|generate|' should follow the parameters
  7.  
  8. autorounding:=0; smoothing:=0; % we do our own rounding
  9. def autorounded = interim autorounding:=2 enddef;
  10.  
  11. newinternal slant,fudge,math_spread,superness,superpull,beak_darkness,ligs;
  12. boolean square_dots,hefty,serifs,
  13.  monospace,variant_g,low_asterisk,math_fitting;
  14.  
  15. boolean dark,dark.dark,skewed,skewed.skewed; % for fast option testing
  16. dark=skewed=false; dark.dark=skewed.skewed=true;
  17.  
  18. vardef Vround primary y = y_:=vround y;
  19.  if y_<min_Vround: min_Vround else: y_ fi enddef;
  20. newinternal y_,min_Vround;
  21.  
  22. vardef serif(suffix $,$$,@)  % serif at |z$| for stroke from |z$$|
  23.   (expr darkness,jut) suffix modifier =
  24.  pickup crisp.nib; numeric bracket_height; pair downward;
  25.  bracket_height=if dark.modifier: 1.5 fi\\ bracket;
  26.  if y$<y$$: y@2=min(y$+bracket_height,y$$);
  27.   top y@1-slab=bot y@0+eps=tiny.bot y$; downward=z$-z$$;
  28.   if y@1>y@2: y@2:=y@1; fi
  29.  else: y@2=max(y$-bracket_height,y$$);
  30.   bot y@1+slab=top y@0-eps=tiny.top y$; downward=z$$-z$;
  31.   if y@1<y@2: y@2:=y@1; fi fi
  32.  y@3=y@2; z@3=whatever[z$,z$$];
  33.  if jut<0: z@2+penoffset downward of currentpen =
  34.    z$l+penoffset downward of pen_[tiny.nib]+whatever*downward;
  35.   lft x@0=lft x@1=tiny.lft x$l+jut;
  36.   if x@3<x@2+eps: x@3:=x@2+eps; fi
  37.  else: z@2-penoffset downward of currentpen =
  38.    z$r-penoffset downward of pen_[tiny.nib]+whatever*downward;
  39.    rt x@0=rt x@1=tiny.rt x$r+jut;
  40.    if x@3>x@2-eps: x@3:=x@2-eps; fi fi
  41.  pair corner; ypart corner=y@1; corner=z@2+whatever*downward;
  42.  filldraw z@2{z$-z$$}
  43.   ...darkness[corner,.5[z@1,z@2] ]{z@1-z@2}
  44.   ...{jut,0}z@1--z@0--(x$,y@0)--z@3--cycle; % the serif
  45.  labels (@1,@2); enddef;
  46.  
  47. def dish_serif(suffix $,$$,@)(expr left_darkness,left_jut)
  48.   (suffix @@)(expr right_darkness,right_jut) suffix modifier =
  49.  serif($,$$,@,left_darkness,-left_jut) modifier;
  50.  serif($,$$,@@,right_darkness,right_jut) modifier;
  51.  if dish>0: pickup tiny.nib; numeric dish_out,dish_in;
  52.   if y$<y$$: dish_out=bot y$; dish_in=dish_out+dish; let rev_=reverse;
  53.   else: dish_out=top y$; dish_in=dish_out-dish; let rev_=relax; fi
  54.   erase fill rev_
  55.    ((x@1,dish_out)..(x$,dish_in){right}..(x@@1,dish_out)--cycle);
  56.  fi enddef;
  57.  
  58. def nodish_serif(suffix $,$$,@)(expr left_darkness,left_jut)
  59.   (suffix @@)(expr right_darkness,right_jut) suffix modifier =
  60.  serif($,$$,@,left_darkness,-left_jut) modifier;
  61.  serif($,$$,@@,right_darkness,right_jut) modifier; enddef;
  62.  
  63. vardef sloped_serif.l(suffix $,$$,@)(expr darkness,jut,drop) =
  64.  pickup crisp.nib; pos@2(slab,90);
  65.  lft x@0=tiny.lft x$l; rt x@1=tiny.rt x$r; top y@1=tiny.top y$r;
  66.  lft x@2=lft x@0-jut; y@2r=y@1-drop;
  67.  y@0=max(y@2l-bracket,y$$)-eps;
  68.  if drop>0: erase fill z@1--top z@1
  69.    --(x@2r,top y@1)--z@2r--cycle; fi % erase excess at top
  70.  filldraw z@1--z@2r--z@2l{right}
  71.   ...darkness[(x@0,y@2l),.5[z@2l,z@0] ]{z@0-z@2l}
  72.   ...{down}z@0--(x@1,y@0)--cycle;  % sloped serif
  73.  labels(@0,@1,@2); enddef;
  74.  
  75. vardef sloped_serif.r(suffix $,$$,@)(expr darkness,jut,drop) =
  76.  pickup crisp.nib; pos@2(slab,-90);
  77.  rt x@0=tiny.rt x$r; lft x@1=tiny.lft x$l; bot y@1=tiny.bot y$l;
  78.  rt x@2=rt x@0+jut; y@2r=y@1+drop;
  79.  y@0=min(y@2l+bracket,y$$)+eps;
  80. if drop>0: erase fill z@1--bot z@1
  81.   --(x@2r,bot y@1)--z@2r--cycle; fi % erase excess at bottom
  82.  filldraw z@1--z@2r--z@2l{left}
  83.   ...darkness[(x@0,y@2l),.5[z@2l,z@0] ]{z@0-z@2l}
  84.   ...{up}z@0--(x@1,y@0)--cycle;  % sloped serif
  85.  labels(@0,@1,@2); enddef;
  86.  
  87. vardef term.l(suffix $,$$)(expr d,t,s)= % ``robust'' sans-serif terminal
  88.  path p_; p_=z$l{d}..tension t..z$$l;
  89.  pair d_; d_=(x$$l-x$l,s*(y$$l-y$l));
  90.  if (abs angle direction 1 of p_ < abs angle d_)<>(x$l<x$$l):
  91.   p_:=z$l{d}..tension atleast t..{d_}z$$l; fi
  92.  p_ enddef;
  93. vardef term.r(suffix $,$$)(expr d,t,s)=
  94.  path p_; p_=z$r{d}..tension t..z$$r;
  95.  pair d_; d_=(x$$r-x$r,s*(y$$r-y$r));
  96.  if (abs angle direction 1 of p_ < abs angle d_)<>(x$r<x$$r):
  97.   p_:=z$r{d}..tension atleast t..{d_}z$$r; fi
  98.  p_ enddef;
  99. def rterm=reverse term enddef;
  100.  
  101. vardef arm(suffix $,$$,@)(expr darkness,jut) =  % arm from |z$| to |z$$|
  102.  x@0=good.x(x$$r-jut); y@0=y$r;
  103.  if serifs: y@1=y$l; z@1=z$$l+whatever*(z$$r-z@0);
  104.   z@2=.5[z$l,z@1];
  105.   filldraw z$$l{z@1-z$$l}...darkness[z@1,.5[z@2,z$$l] ]...z@2
  106.    ---z$l--z$r--z@0--z$$r--cycle; % arm and beak
  107.  else: filldraw z$l--z$r--z@0--z$$r--cycle; fi  % sans-serif arm
  108.  penlabels(@0,@1,@2); enddef;
  109.  
  110. def pi_stroke = pickup fine.nib;
  111.  pos1(hair,0); pos2(vstem,-90); pos3(vstem,-90);
  112.  x1-.5hair=hround -.5hair; x2=2u; x3=w-1.5u;
  113.  y1=x_height-x_height/3.141592653589793; y2=y3; top y3l=x_height;
  114.  filldraw circ_stroke z3e---z2e...{x1-x2,3.14159(y1-y2)}z1e enddef;
  115.  
  116. def bulb(suffix $,$$,$$$) =
  117.  z$$$r=z$$r;
  118.  path_.l:=z$l{x$$r-x$r,0}...{0,y$$r-y$r}z$$l;
  119.  filldraw path_.l--z$$r{0,y$r-y$$r}...{x$r-x$$r,0}z$r--cycle; % link
  120.  path_.r:=z$$$l{0,y$r-y$$r}..z$$$r{0,y$$r-y$r}; % near-circle
  121.  filldraw subpath(0,xpart(path_.r intersectiontimes path_.l)) of path_.r
  122.   --z$$r{0,y$$r-y$r}..cycle; % bulb
  123.  enddef;
  124.  
  125. def v_bulb(suffix $,$$)= % |pos$| is known
  126.  y$$+.5curve=x_height+oo; x$$+.5curve=w-u;
  127.  numeric theta; theta=angle(4(x$-x$$),y$-y$$); pos$$(curve,theta+90);
  128.  filldraw z$$l{dir theta}..tension atleast 1 and 1..{down}z$l
  129.   --z$r{up}...{-dir theta}z$$r..cycle;  % bulb
  130.  enddef;
  131.  
  132. def dot(suffix $,$$) =
  133.  filldraw if square_dots: (x$l,y$$l)--(x$r,y$$l)
  134.    --(x$r,y$$r)--(x$l,y$$r)--cycle  % squarish dot
  135.   else: z$l...z$$l...z$r...z$$r...cycle  fi % roundish dot
  136.  enddef;
  137.  
  138. def comma(suffix $,@)(expr dot_size,jut,depth) =
  139.  pickup fine.nib; pos$(dot_size,90);
  140.  if square_dots: pos$'(dot_size,0); z$'=z$; dot($',$);  % squarish dot
  141.   comma_join_:=max(fine.breadth,floor .7dot_size);
  142.   comma_bot_:=max(fine.breadth,floor .5dot_size);
  143.   pos@0(comma_join_,0); pos@1(comma_join_,0);
  144.   pos@2(comma_bot_,0); y@0=y$; y@1=y$l; y@2=y@1-depth;
  145.   x@0r=x@1r=x$'r; rt x@2r=good.x(x$-eps);
  146.   filldraw stroke z@0e--z@1e..z@2e;  % tail
  147.  else: pos@1(vair,90); pos@2(vair,0); pos@3(vair,-45);
  148.   z@1r=z$r; rt x@2r=hround(x$+.5dot_size+jut)+2eps; x@3=x$-.5u;
  149.   y@2=1/3[y@1,y@3]; bot y@3r=vround(y$-.5dot_size-depth);
  150.   y_:=ypart((z@1{right}...z@2{down}...z@3)
  151.    intersectiontimes (z$l{right}..{left}z$r)); if y_<0: y_:=1; fi
  152.   filldraw z$r{left}..subpath (0,y_) of (z$l{right}..{left}z$r)--cycle; % dot
  153.   filldraw stroke z@1e{right}...z@2e{down}...z@3e; fi  % tail
  154.  penlabels(@1,@2,@3); enddef;
  155.  
  156. def ammoc(suffix $,@)(expr dot_size,jut,depth) = % reversed comma
  157.  pickup fine.nib; pos$(dot_size,90);
  158.  if square_dots: pos$'(dot_size,0); z$'=z$; dot($',$);  % squarish dot
  159.   comma_join_:=max(fine.breadth,floor .7dot_size);
  160.   comma_top_:=max(fine.breadth,floor .5dot_size);
  161.   pos@0(comma_join_,0); pos@1(comma_join_,0);
  162.   pos@2(comma_top_,0); y@0=y$; y@1=y$r; y@2=y@1+depth;
  163.   x@0l=x@1l=x$'l; lft x@2l=good.x(x$+eps);
  164.   filldraw stroke z@0e--z@1e..z@2e;  % tail
  165.  else: pos@1(vair,90); pos@2(vair,0); pos@3(vair,-45);
  166.   z@1l=z$l; lft x@2l=hround(x$-.5dot_size-jut)-2eps; x@3=x$+.5u;
  167.   y@2=1/3[y@1,y@3]; top y@3l=vround(y$+.5dot_size+depth);
  168.   y_:=ypart((z@1{left}...z@2{up}...z@3)
  169.    intersectiontimes (z$r{left}..{right}z$l)); if y_<0: y_:=1; fi
  170.   filldraw z$l{right}..subpath (0,y_) of (z$r{left}..{right}z$l)--cycle; % dot
  171.   filldraw stroke z@1e{left}...z@2e{up}...z@3e; fi  % tail
  172.  penlabels(@1,@2,@3); enddef;
  173.  
  174. %%% @ from to %%%% temporary formatting change
  175. vardef diag_in(suffix from,$)(expr sharpness)(suffix $$) =
  176.  pickup tiny.nib; save from_x,y_;
  177.  if y.from>y$: bot else: top fi\\ y_=y$;
  178.  (from_x,y_)=whatever[z.from,z$];
  179.  sharpness[z$,(from_x,y_)]{z$-z.from}
  180.   ...{z$$-z$}z$+sharpness*length(z$-(from_x,y_))*unitvector(z$$-z$) enddef;
  181.  
  182. vardef diag_out(suffix $)(expr sharpness)(suffix $$,to) =
  183.  pickup tiny.nib; save to_x,y_;
  184.  if y.to>y$: bot else: top fi\\ y_=y$;
  185.  (to_x,y_)=whatever[z$$,z.to];
  186.  z$$-sharpness*length(z$$-(to_x,y_))*unitvector(z$$-z$){z$$-z$}
  187.   ...{z.to-z$$}sharpness[z$$,(to_x,y_)] enddef;
  188.  
  189. vardef diag_end(suffix from,$)(expr sharpness_in,sharpness_out)(suffix $$,to)=
  190.  save from_x,to_x,y_,x_,xx_;
  191.  if y.from>y$: tiny.bot else: tiny.top fi\\ y_=y$; % we assume that |y$=y$$|
  192.  (from_x,y_)=whatever[z.from,z$]; (to_x,y_)=whatever[z$$,z.to];
  193.  if x$$>x$: x_=x$+sharpness_in*length(z$-(from_x,y_));
  194.   xx_=x$$-sharpness_out*length(z$$-(to_x,y_));
  195.   if xx_<x_: xx_:=x_:=.5[xx_,x_]; fi
  196.  else: x_=x$-sharpness_in*length(z$-(from_x,y_));
  197.   xx_=x$$+sharpness_out*length(z$$-(to_x,y_));
  198.   if xx_>x_: xx_:=x_:=.5[xx_,x_]; fi fi
  199.  sharpness_in[z$,(from_x,y_)]{z$-z.from}
  200.   ...{z$$-z$}(x_,y$)..(xx_,y$){z$$-z$}
  201.   ...{z.to-z$$}sharpness_out[z$$,(to_x,y_)] enddef;
  202. %%% at from to %%%% restore normal formatting
  203.  
  204. vardef special_diag_end(suffix $$,$,@,@@) = % for top middle of w's
  205.  if x@r<=x$r: diag_end($$r,$r,1,1,@l,@@l)
  206.  else: z0=whatever[z$$l,z$l]=whatever[z@l,z@@l];
  207.   diag_end($$r,$r,1,1,$l,0)--z0 fi enddef;
  208.  
  209. def prime_points_inside(suffix $,$$) =
  210.  theta_:=angle(z$r-z$l);
  211.  penpos$'(whatever,theta_);
  212.  if y$$>y$: z$'=(0,pen_top) rotated theta_ + whatever[z$l,z$r];
  213.   theta_:=angle(z$$-z$)-90;
  214.  else: z$'=(0,pen_bot) rotated theta_ + whatever[z$l,z$r];
  215.   theta_:=angle(z$$-z$)+90; fi
  216.  z$'l+(pen_lft,0) rotated theta_=z$l+whatever*(z$-z$$);
  217.  z$'r+(pen_rt,0) rotated theta_=z$r+whatever*(z$-z$$);
  218.  enddef;
  219.  
  220. def ellipse_set(suffix $,@,@@,$$) = % given |z$,x@,z$$|, find |y@| and |z@@|
  221. % such that the path |z${x@-x$,0}..z@{0,y@-y$}..{z$$-z@@}z@@|
  222. % is consistent with an ellipse
  223. % and such that the line |z@@--z$$| has a given |slope|
  224.  alpha_:=slope*(x@-x$); beta_:=y$$-y$-slope*(x$$-x$);
  225.  gamma_:=alpha_/beta_;
  226.  y@-y$=.5(beta_-alpha_*gamma_);
  227.  x@@-x$=-2gamma_*(x@-x$)/(1+gamma_*gamma_);
  228.  y@@-y$$=slope*(x@@-x$$) enddef;
  229.  
  230. vardef diag_ratio(expr a,b,y,c) = % assuming that $a>\vert b/y\vert$,
  231. % compute the value $\alpha=(x\6{++}y)/y$ such that $ax+b\alpha=c$
  232.  numeric a_,b_; b_=b/y; a_=a*a-b_*b_;
  233.  (a*(c++y*sqrt a_)-b_*c)/a_/y enddef;
  234.  
  235. def f_stroke(suffix $,$$,@,left_serif,right_serif)(expr left_jut,right_jut)=
  236.  pickup tiny.nib; bot y$=0;
  237.  penpos@0(x$r-x$l,0); x@0l=x$l; top y@0=x_height;
  238.  filldraw stroke z$e--z@0e;  % stem
  239.  pickup fine.nib; pos@0'(x$r-x$l-(hround stem_corr)+tiny,180);
  240.  y@0'=y@0; lft x@0'r=tiny.lft x$l;
  241.  penpos@1(x@0'l-x@0'r,180); x@1=x@0'; y@1+.5vair=.5[x_height,h];
  242.  pos@2(vair,90); top y@2r=h+oo;
  243.  if serifs: x@2=.6[x@1,x$$r]; (x@,y@2r)=whatever[z@2l,z@1l];
  244.   x@2r:=min(x@,.5[x@2,x$$r]); pos@3(hair,0); bulb(@2,@3,$$);  % bulb
  245.   filldraw stroke z@0'e--z@1e & super_arc.e(@1,@2);  % arc
  246.   dish_serif($,@0,left_serif,1/3,left_jut,right_serif,1/3,right_jut); % serif
  247.  else: x@2=.6[x@1,x$$]; y@1l:=1/3[y@1l,y@2l];
  248.   filldraw stroke z@0'e--z@1e & super_arc.e(@1,@2)
  249.    & term.e(@2,$$,right,.9,4); fi  % arc and terminal
  250.  penlabels(@0,@1,@2); enddef;
  251.  
  252. def h_stroke(suffix $,@,@@,$$) =
  253.  penpos$$(x@@r-x@@l,0); x$$=x@@; bot y$$=0;
  254.  y@@=1/3[bar_height,x_height];
  255.  penpos$''(x$r-x$l,0); x$''=x$; y$''=1/8[bar_height,x_height];
  256.  filldraw stroke z$''e--z$e;  % thicken the lower left stem
  257.  penpos@0(min(rt x$r-lft x$l,thin_join)-fine,180); pickup fine.nib;
  258.  rt x@0l=tiny.rt x$r; y@0=y$'';
  259.  pos@1(vair,90); pos@@'(x@@r-x@@l+tiny,0); z@@'=z@@;
  260.  x@1=.5[rt x@0l,rt x@@'r]; top y@1r=x_height+oo;
  261.  (x@,y@1l)=whatever[z@1r,z@0l]; x@1l:=x@;
  262.  filldraw stroke z@0e{up}...{right}z@1e
  263.   &{{interim superness:=hein_super; super_arc.e(@1,@@')}};  % arch
  264.  pickup tiny.nib; filldraw stroke z@@e--z$$e;  % right stem
  265.  labels(@0); penlabels(@1); enddef;
  266.  
  267. def hook_out(suffix $,$$,$$$)suffix modifier= % |x$| and |x$$$| (only) are known
  268.  pos$(stem,0); pos$$(vair,90);
  269.  x$$$:=hround(x$$$+.5hair-eps)-.5hair; pos$$$(hair,180);
  270.  y$=1/4x_height; bot y$$l=-oo; y$$$=1/3x_height;
  271.  if skewed.modifier: x$$=x$+1.25u;
  272.   filldraw stroke z$e{-u,-x_height}...z$$e{right}...{up}z$$$e;  % hook
  273.  else: x$$=x$+1.5u;
  274.   filldraw stroke z$e{down}...z$$e{right}
  275.    ...{x$$$-(x$+2.5u),x_height}z$$$e; fi enddef;  % hook
  276.  
  277. def hook_in(suffix $,$$,$$$)suffix modifier= % |x$| and |x$$$| (only) are known
  278.  x$:=hround(x$-.5hair)+.5hair; pos$(hair,180);
  279.  pos$$(vair,90); pos$$$(stem,0);
  280.  y$=2/3x_height; top y$$r=x_height+oo; y$$$=3/4x_height;
  281.  if skewed.modifier: x$$=x$$$-1.25u;
  282.   filldraw stroke z$e{up}...z$$e{right}...{-u,-x_height}z$$$e;  % hook
  283.  else: x$$=x$$$-1.5u;
  284.   filldraw stroke z$e{x$$$-2.5u-x$,x_height}
  285.    ...z$$e{right}...{down}z$$$e; fi enddef;  % hook
  286.  
  287. def ital_arch(suffix $,$$,$$$) = % |z$| and |z$$$| (only) are known
  288.  pos$'(hair,180); z$'=z$;
  289.  pos$$(vair,90); pos$$$(stem,0);
  290.  {{interim superness := more_super; x$$=.6[x$,x$$$];
  291.  top y$$r=x_height+oo; y$$$=.65x_height;
  292.  filldraw stroke z$'e{up}...super_arc.e($$,$$$);}} enddef;  % stroke
  293.  
  294. def compute_spread(expr normal_spread,big_spread)=
  295.  spread#:=math_spread[normal_spread,big_spread];
  296.  spread:=ceiling(spread#*hppp)+eps; enddef;
  297.  
  298. def v_center(expr h_sharp) =
  299.  .5h_sharp+math_axis#, .5h_sharp-math_axis# enddef;
  300.  
  301. def circle_points =
  302.  x4=x8=.5[x2,x6]; x1=x3=superness[x4,x2]; x5=x7=superness[x4,x6];
  303.  y2=y6=.5[y4,y8]; y1=y7=superness[y2,y8]; y3=y5=superness[y2,y4];
  304.  enddef;
  305. def draw_circle =
  306.  draw z8{right}...z1{z2-z8}...z2{down}...z3{z4-z2}...z4{left}
  307.   ...z5{z6-z4}...z6{up}...z7{z8-z6}...cycle enddef;
  308.  
  309. def left_paren(expr min_breadth, max_breadth) =
  310.  pickup fine.nib; pos1(hround min_breadth,0);
  311.  pos2(hround max_breadth,0); pos3(hround min_breadth,0);
  312.  rt x1r=rt x3r=hround(w-1.25u+.5min_breadth); lft x2l=hround 1.25u;
  313.  top y1=h; y2=.5[y1,y3]; bot y3=1-d;
  314.  filldraw stroke z1e{3(x2e-x1e),y2-y1}...z2e
  315.   ...{3(x3e-x2e),y3-y2}z3e;  % arc
  316.  penlabels(1,2,3); enddef;
  317.  
  318. def right_paren(expr min_breadth, max_breadth) =
  319.  pickup fine.nib; pos1(hround min_breadth,0);
  320.  pos2(hround max_breadth,0); pos3(hround min_breadth,0);
  321.  lft x1l=lft x3l=hround(1.25u-.5min_breadth); rt x2r=hround(w-1.25u);
  322.  top y1=h; y2=.5[y1,y3]; bot y3=1-d;
  323.  filldraw stroke z1e{3(x2e-x1e),y2-y1}...z2e
  324.   ...{3(x3e-x2e),y3-y2}z3e;  % arc
  325.  penlabels(1,2,3); enddef;
  326.  
  327. def left_bracket(expr breadth,do_top,do_bot) =
  328.  pickup crisp.nib;
  329.  numeric thickness; thickness=hround breadth;
  330.  pos1(thickness,0); pos2(thickness,0);
  331.  top y1=h; bot y2=1-d; lft x1l=lft x2l=hround(2.5u-.5thickness);
  332.  filldraw stroke z1e--z2e;  % stem
  333.  pos3(thickness,90); pos4(thickness,90);
  334.  pos5(thickness,90); pos6(thickness,90);
  335.  x3=x5=x1l; rt x4=rt x6=hround(w-.75u+.5thickness);
  336.  y3r=y4r=y1; y5l=y6l=y2;
  337.  if do_top: filldraw stroke z3e--z4e; fi  % upper bar
  338.  if do_bot: filldraw stroke z5e--z6e; fi  % lower bar
  339.  penlabels(1,2,3,4,5,6); enddef;
  340.  
  341. def right_bracket(expr breadth,do_top,do_bot) =
  342.  pickup crisp.nib;
  343.  numeric thickness; thickness=hround breadth;
  344.  pos1(thickness,0); pos2(thickness,0);
  345.  top y1=h; bot y2=1-d; rt x1r=rt x2r=hround(w-2.5u+.5thickness);
  346.  filldraw stroke z1e--z2e;  % stem
  347.  pos3(thickness,90); pos4(thickness,90);
  348.  pos5(thickness,90); pos6(thickness,90);
  349.  x3=x5=x1r; lft x4=lft x6=hround(.75u-.5thickness);
  350.  y3r=y4r=y1; y5l=y6l=y2;
  351.  if do_top: filldraw stroke z3e--z4e; fi  % upper bar
  352.  if do_bot: filldraw stroke z5e--z6e; fi  % lower bar
  353.  penlabels(1,2,3,4,5,6); enddef;
  354.  
  355. def left_curly(expr min_breadth, max_breadth) =
  356.  pickup fine.nib;
  357.  forsuffixes $=1,1',4,4',7,7': pos$(hround min_breadth,0); endfor
  358.  forsuffixes $=2,3,5,6: pos$(hround max_breadth,0); endfor
  359.  x2=x3=x5=x6; x1=x1'=x7=x7'=w-x4=w-x4';
  360.  lft x4l=hround(1.5u-.5min_breadth); lft x2l=hround(.5w-.5max_breadth);
  361.  top y1=h; bot y7=1-d; .5[y4,y4']=.5[y1,y7]=.5[y2,y6]=.5[y3,y5];
  362.  y1-y2=y3-y4=(y1-y4)/4;
  363.  y1-y1'=y4-y4'=y7'-y7=vround(min_breadth-fine);
  364.  filldraw z1l{3(x2l-x1l),y2-y1}...z2l---z3l...{3(x4l-x3l),y4-y3}z4l
  365.   --z4'l{3(x5l-x4l),y5-y4'}...z5l---z6l...{3(x7l-x6l),y7-y6}z7l
  366.   --z7r--z7'r{3(x6r-x7r),y6-y7'}...z6r---z5r
  367.   ...{3(x4r-x5r),.5[y4,y4']-y5}.5[z4r,z4'r]{3(x3r-x4r),y3-.5[y4,y4']}
  368.   ...z3r---z2r...{3(x1r-x2r),y1'-y2}z1'r--z1r--cycle;  % stroke
  369.  penlabels(1,2,3,4,5,6,7); enddef;
  370.  
  371. def right_curly(expr min_breadth, max_breadth) =
  372.  pickup fine.nib;
  373.  forsuffixes $=1,1',4,4',7,7': pos$(hround min_breadth,0); endfor
  374.  forsuffixes $=2,3,5,6: pos$(hround max_breadth,0); endfor
  375.  x2=x3=x5=x6; x1=x1'=x7=x7'=w-x4=w-x4';
  376.  lft x1l=hround(1.5u-.5min_breadth); lft x2l=hround(.5w-.5max_breadth);
  377.  top y1=h; bot y7=1-d; .5[y4,y4']=.5[y1,y7]=.5[y2,y6]=.5[y3,y5];
  378.  y1-y2=y3-y4=(y1-y4)/4;
  379.  y1-y1'=y4-y4'=y7'-y7=vround(min_breadth-fine);
  380.  filldraw z1r{3(x2r-x1r),y2-y1}...z2r---z3r...{3(x4r-x3r),y4-y3}z4r
  381.   --z4'r{3(x5r-x4r),y5-y4'}...z5r---z6r...{3(x7r-x6r),y7-y6}z7r
  382.   --z7l--z7'l{3(x6l-x7l),y6-y7'}...z6l---z5l
  383.   ...{3(x4l-x5l),.5[y4,y4']-y5}.5[z4l,z4'l]{3(x3l-x4l),y3-.5[y4,y4']}
  384.   ...z3l---z2l...{3(x1l-x2l),y1'-y2}z1'l--z1l--cycle;  % stroke
  385.  penlabels(1,2,3,4,5,6,7); enddef;
  386.  
  387. def left_angle(expr breadth) =
  388.  pickup pencircle scaled breadth;
  389.  x1=x3=good.x(w-u)+eps; lft x2=hround u-eps;
  390.  top y1=h+eps; .5[y1,y3]=y2=good.y .5[-d+eps,h];
  391.  draw z1--z2--z3;  % diagonals
  392.  labels(1,2,3); enddef;
  393.  
  394. def right_angle(expr breadth) =
  395.  pickup pencircle scaled breadth;
  396.  x1=x3=good.x u-eps; rt x2=hround(w-u)+eps;
  397.  top y1=h+eps; .5[y1,y3]=y2=good.y .5[-d+eps,h];
  398.  draw z1--z2--z3;  % diagonals
  399.  labels(1,2,3); enddef;
  400.  
  401. def big_slash(expr breadth) =
  402.  adjust_fit(-letter_fit#,-letter_fit#); pickup pencircle scaled breadth;
  403.  rt x1=hround(w-u); lft x2=hround u; top y1=h+eps; bot y2=1-d-eps;
  404.  draw z1--z2;  % diagonal
  405.  labels(1,2); enddef;
  406.  
  407. def big_blash(expr breadth) =
  408.  adjust_fit(-letter_fit#,-letter_fit#); pickup pencircle scaled breadth;
  409.  lft x1=hround u; rt x2=hround(w-u); top y1=h+eps; bot y2=1-d-eps;
  410.  draw z1--z2;  % diagonal
  411.  labels(1,2); enddef;
  412.  
  413. def big_sqrt =
  414.  adjust_fit(0,-letter_fit#); pickup rule.nib;
  415.  x1=good.x 4/9w; x2=good.x(w+.5); bot y1=-d; bot y2=0;
  416.  draw z1--z2;  % diagonal
  417.  pickup crisp.nib; pos3(max(curve,rule_thickness),0);
  418.  x3l=1.5[x2,x1]; y3=.5[y1,y2];
  419.  pos4(rule_thickness,0); x4=x1; bot y4=-d;
  420.  pos5(vair,-45); x5l=good.x(x3l-u); z5l=whatever[z3r,z2];
  421.  z6=z5r+whatever*(z2-z3r)=whatever[z3l,z4l];
  422.  z7=whatever[z1,z2]=z3r+whatever*(z4l-z3l);
  423.  filldraw z5r--z6--z4l--z4--z7--z3r--z5l--cycle;  % left diagonal and serif
  424.  penlabels(1,2,3,4,5,6,7); enddef;
  425.  
  426. def big_hat =
  427.  adjust_fit(0,0);
  428.  pickup crisp.nib; pos2(.6[vair,curve],90); top y2r=h+o; x2=.5w;
  429.  x1=w-x3=good.x -eps; y1=y3=.5[x_height,y2];
  430.  pos1(hair,angle(z2-z1)+90); pos3(hair,angle(z3-z2)+90);
  431.  filldraw stroke z1e--z2e--z3e;  % diagonals
  432.  penlabels(1,2,3); enddef;
  433.  
  434. def big_tilde =
  435.  adjust_fit(0,0); pickup crisp.nib;
  436.  numeric theta; theta=angle(1/6(w-vair),1/4(h-x_height));
  437.  numeric mid_width; mid_width=.4[vair,stem];
  438.  pos1(vair,theta+90); pos2(vair,theta+90);
  439.  pos3(vair,theta+90); pos4(vair,theta+90);
  440.  z2-z1=z4-z3=(mid_width-crisp)*dir theta;
  441.  lft x1r=w-rt x4l=0; top y4r=h;
  442.  bot y1l=vround(bot y1l+min(2/3[x_height,h],y3l-.25vair)-top y1r);
  443.  pair delta; ypart delta=3(y3l-y1l); delta=whatever*dir theta;
  444.  filldraw z1l..controls(z1l+delta)and(z3l-delta)..z3l..z4l
  445.   --z4r..controls(z4r-delta)and(z2r+delta)..z2r..z1r--cycle;  % stroke
  446.  penlabels(1,2,3,4); enddef;
  447.  
  448. def beginarithchar(expr c) = % ensure consistent dimensions for $+$, $-$, etc.
  449.  if monospace: beginchar(c,14u#,27/7u#+math_axis#,27/7u#-math_axis#);
  450.  else: beginchar(c,14u#,6u#+math_axis#,6u#-math_axis#); fi
  451.  italcorr math_axis#*slant-.5u#;
  452.  adjust_fit(0,0); enddef;
  453.  
  454. newinternal l,r,shrink_fit; % adjustments to spacing
  455.  
  456. def do_expansion(expr expansion_factor) =
  457.  forsuffixes $=u,jut,cap_jut,beak_jut,apex_corr:
  458.    $:=$.#*expansion_factor*hppp; endfor
  459. enddef;
  460.  
  461. def normal_adjust_fit(expr left_adjustment,right_adjustment) =
  462.  numeric charwd_in; charwd_in=charwd;
  463.  l:=-hround(left_adjustment*hppp)-letter_fit;
  464.  interim xoffset:=-l;
  465.  charwd:=charwd+2letter_fit#+left_adjustment+right_adjustment;
  466.  r:=l+hround(charwd*hppp)-shrink_fit;
  467.  w:=r-hround(right_adjustment*hppp)-letter_fit;
  468.  do_expansion(w/(charwd_in*hppp));
  469.  enddef;
  470.  
  471. def mono_adjust_fit(expr left_adjustment,right_adjustment) =
  472.  numeric charwd_in; charwd_in=charwd;
  473.  numeric expansion_factor;
  474.  mono_charwd#=2letter_fit#
  475.    +expansion_factor*(charwd+left_adjustment+right_adjustment);
  476.  l:=-hround(left_adjustment*expansion_factor*hppp)-letter_fit;
  477.  interim xoffset:=-l;
  478.  r:=l+mono_charwd-shrink_fit;
  479.  w:=r-hround(right_adjustment*expansion_factor*hppp)-letter_fit;
  480.  charwd:=mono_charwd#; charic:=mono_charic#;
  481.  do_expansion(w/(charwd_in*hppp));
  482.  enddef;
  483.  
  484. extra_endchar:=extra_endchar&"r:=r+shrink_fit;w:=r-l;";
  485.  
  486. def ignore_math_fit(expr left_adjustment,right_adjustment) = enddef;
  487. def do_math_fit(expr left_adjustment,right_adjustment) =
  488.  l:=l-hround(left_adjustment*hppp); interim xoffset:=-l;
  489.  charwd:=charwd+left_adjustment+right_adjustment;
  490.  r:=l+hround(charwd*hppp)-shrink_fit;
  491.  charic:=charic-right_adjustment;
  492.  if charic<0: charic:=0; fi enddef;
  493. def zero_width = charwd:=0; r:=l-shrink_fit enddef;
  494. def change_width = if not monospace: % change width by $\pm1$
  495.  if r+shrink_fit-l=floor(charwd*hppp): w:=w+1; r:=r+1;
  496.  else: w:=w-1; r:=r-1; fi fi enddef;
  497. def center_on(expr x) = if not monospace: % change width for symmetric fit
  498.  r:=r+2x-w; w:=2x; fi enddef;
  499. def padded expr del_sharp =
  500.  charht:=charht+del_sharp; chardp:=chardp+del_sharp enddef;
  501.  
  502. def font_setup =
  503.  if monospace: let adjust_fit=mono_adjust_fit;
  504.   def mfudged=fudged enddef;
  505.   mono_charic#:=body_height#*slant;
  506.   if mono_charic#<0: mono_charic#:=0; fi
  507.   mono_charwd#:=9u#; define_whole_pixels(mono_charwd);
  508.  else: let adjust_fit=normal_adjust_fit;
  509.   def mfudged= enddef; fi
  510.  if math_fitting: let math_fit=do_math_fit
  511.  else: let math_fit=ignore_math_fit fi;
  512.  define_pixels(u,width_adj,serif_fit,cap_serif_fit,jut,cap_jut,beak,
  513.   bar_height,dish,bracket,beak_jut,stem_corr,vair_corr,apex_corr);
  514.  define_blacker_pixels(notch_cut,cap_notch_cut);
  515.  forsuffixes $=notch_cut,cap_notch_cut: if $<3: $:=3; fi endfor
  516.  define_whole_pixels(letter_fit,fine,crisp,tiny);
  517.  define_whole_vertical_pixels(body_height,asc_height,
  518.   cap_height,fig_height,x_height,comma_depth,desc_depth,serif_drop);
  519.  define_whole_blacker_pixels(thin_join,hair,stem,curve,flare,
  520.   dot_size,cap_hair,cap_stem,cap_curve);
  521.  define_whole_vertical_blacker_pixels(vair,bar,slab,cap_bar,cap_band);
  522.  define_corrected_pixels(o,apex_o);
  523.  forsuffixes $=hair,stem,cap_stem:
  524.   fudged$.#:=fudge*$.#; fudged$:=hround(fudged$.#*hppp+blacker);
  525.   forever: exitif fudged$>.9fudge*$; fudged$:=fudged$+1; endfor endfor
  526.  rule_thickness:=ceiling(rule_thickness#*hppp);
  527.  heavy_rule_thickness:=ceiling(3rule_thickness#*hppp);
  528.  oo:=vround(.5o#*hppp*o_correction)+eps;
  529.  apex_oo:=vround(.5apex_o#*hppp*o_correction)+eps;
  530.  lowres_fix(stem,curve,flare) 1.3;
  531.  lowres_fix(stem,curve) 1.2;
  532.  lowres_fix(cap_stem,cap_curve) 1.2;
  533.  lowres_fix(hair,cap_hair) 1.2;
  534.  lowres_fix(cap_band,cap_bar,bar,slab) 1.2;
  535.  stem':=hround(stem-stem_corr); cap_stem':=hround(cap_stem-stem_corr);
  536.  vair':=vround(vair+vair_corr);
  537.  vstem:=vround .8[vair,stem]; cap_vstem:=vround .8[vair,cap_stem];
  538.  ess:=(ess#/stem#)*stem; cap_ess:=(cap_ess#/cap_stem#)*cap_stem;
  539.  dw:=(curve#-stem#)*hppp; bold:=curve#*hppp+blacker;
  540.  dh#:=.6designsize;
  541.  stem_shift#:=if serifs: 2stem_corr# else: 0 fi;
  542.  more_super:=max(superness,sqrt .77superness);
  543.  hein_super:=max(superness,sqrt .81225258superness); % that's $2^{-.3}$
  544.  clear_pen_memory;
  545.  if fine=0: fine:=1; fi
  546.  forsuffixes $=fine,crisp,tiny:
  547. %%% fine $ %%%% temporary formatting convention for MFT
  548.   if $>fudged.hair: $:=fudged.hair; fi
  549.   $.breadth:=$;
  550.   pickup if $=0: nullpen else: pencircle scaled $; $:=$-eps fi;
  551.   $.nib:=savepen; breadth_[$.nib]:=$;
  552.   forsuffixes $$=lft,rt,top,bot: shiftdef($.$$,$$ 0); endfor endfor
  553. %%% @ $ %%%% restore ordinary formatting for $
  554.  min_Vround:=max(fine.breadth,crisp.breadth,tiny.breadth);
  555.  if min_Vround<vround min_Vround: min_Vround:=vround min_Vround; fi
  556.  if flare<vround flare: flare:=vround flare; fi
  557.  forsuffixes $=vair,bar,slab,cap_bar,cap_band,vair',vstem,cap_vstem,bold:
  558.   if $<min_Vround: $:=min_Vround; fi endfor
  559.  pickup pencircle scaled rule_thickness; rule.nib:=savepen;
  560.  math_axis:=good.y(math_axis#*hppp);
  561.  pickup pencircle scaled if hefty:(.6[vair,fudged.hair]) else:fudged.hair fi;
  562.  light_rule.nib:=savepen;
  563.  pickup pencircle xscaled cap_curve yscaled cap_hair rotated 30;
  564.  cal.nib:=savepen;
  565.  pair cal.extension; cal.extension:=(.75cap_curve,0) rotated 30;
  566.  pickup pencircle xscaled cap_curve yscaled cap_hair rotated 70;
  567.  tilted.nib:=savepen;
  568.  pickup pencircle xscaled curve yscaled cap_hair rotated 70;
  569.  med_tilted.nib:=savepen;
  570.  pickup pencircle xscaled cap_stem yscaled cap_hair rotated 30;
  571.  med_cal.nib:=savepen;
  572.  pickup pencircle xscaled stem yscaled cap_hair rotated 30;
  573.  light_cal.nib:=savepen;
  574.  pickup pencircle xscaled(cap_curve+dw) yscaled cap_hair rotated 30;
  575.  heavy_cal.nib:=savepen;
  576.  bot_flourish_line:=-.5u-o;
  577.  pair bend; bend=(.5u,0);
  578.  pair flourish_change; flourish_change=(4u,.2asc_height);
  579.  join_radius:=u;
  580.  currenttransform:=identity slanted slant
  581.   yscaled aspect_ratio scaled granularity;
  582.  if currenttransform=identity: let t_=relax
  583.  else: def t_ = transformed currenttransform enddef fi;
  584.  numeric paren_depth#; .5[body_height#,-paren_depth#]=math_axis#;
  585.  numeric asc_depth#; .5[asc_height#,-asc_depth#]=math_axis#;
  586.  body_depth:=desc_depth+body_height-asc_height;
  587.  shrink_fit:=1+hround(2letter_fit#*hppp)-2letter_fit;
  588.  if not string mode: if mode<=smoke: shrink_fit:=0; fi fi
  589.  enddef;
  590.  
  591. def shiftdef(suffix $)(expr delta) =
  592.  vardef $ primary x = x+delta enddef enddef;
  593.  
  594. def makebox(text rule) =
  595.  for y=0,asc_height,body_height,x_height,bar_height,-desc_depth,-body_depth:
  596.   rule((l,y)t_,(r,y)t_); endfor % horizontals
  597.  for x=l,r:   rule((x,-body_depth)t_,(x,body_height)t_); endfor % verticals
  598.  for x=u*(1+floor(l/u)) step u until r-1:
  599.   rule((x,-body_depth)t_,(x,body_height)t_); endfor % more verticals
  600.  if charic<>0:
  601.   rule((r+charic*pt,h.o_),(r+charic*pt,.5h.o_)); fi % italic correction
  602.  enddef;
  603. def maketicks(text rule) =
  604.  for y=0,h.o_,-d.o_:
  605.   rule((l,y),(l+10,y)); rule((r-10,y),(r,y)); endfor % horizontals
  606.  for x=l,r:
  607.   rule((x,10-d.o_),(x,-d.o_)); rule((x,h.o_-10),(x,h.o_)); endfor % verticals
  608.  if charic<>0:
  609.   rule((r+charic*pt,h.o_-10),(r+charic*pt,h.o_)); fi % italic correction
  610.  enddef;
  611. rulepen:=pensquare;
  612.  
  613. vardef stroke text t =
  614.  forsuffixes e = l,r: path_.e:=t; endfor
  615.  if cycle path_.l:
  616.   errmessage "Beware: `stroke' isn't intended for cycles"; fi
  617.  path_.l -- reverse path_.r -- cycle enddef;
  618.  
  619. vardef circ_stroke text t =
  620.  forsuffixes e = l,r: path_.e:=t; endfor
  621.  if cycle path_.l:
  622.   errmessage "Beware: `stroke' isn't intended for cycles"; fi
  623.  path_.l -- reverse path_.r .. cycle enddef;
  624.  
  625. vardef super_arc.r(suffix $,$$) = % outside of super-ellipse
  626.  pair center,corner;
  627.  if y$=y$r: center=(x$$r,y$r); corner=(x$r,y$$r);
  628.  else: center=(x$r,y$$r); corner=(x$$r,y$r); fi
  629.  z$.r{corner-z$.r}...superness[center,corner]{z$$.r-z$.r}
  630.   ...{z$$.r-corner}z$$.r enddef;
  631.  
  632. vardef super_arc.l(suffix $,$$) = % inside of super-ellipse
  633.  pair center,corner;
  634.  if y$=y$r: center=(x$$l,y$l); corner=(x$l,y$$l);
  635.  else: center=(x$l,y$$l); corner=(x$$l,y$l); fi
  636.  z$l{corner-z$l}...superness[center,corner]{z$$l-z$l}
  637.   ...{z$$l-corner}z$$l enddef;
  638.  
  639. vardef pulled_super_arc.r(suffix $,$$)(expr superpull) =
  640.  pair center,corner;
  641.  if y$=y$r: center=(x$$r,y$r); corner=(x$r,y$$r);
  642.  else: center=(x$r,y$$r); corner=(x$$r,y$r); fi
  643.  z$r{corner-z$r}...superness[center,corner]{z$$r-z$r}
  644.   ...{z$$r-corner}z$$r enddef;
  645.  
  646. vardef pulled_super_arc.l(suffix $,$$)(expr superpull) =
  647.  pair center,corner,outer_point;
  648.  if y$=y$r: center=(x$$l,y$l); corner=(x$l,y$$l);
  649.   outer_point=superness[(x$$r,y$r),(x$r,y$$r)];
  650.  else: center=(x$l,y$$l); corner=(x$$l,y$l);
  651.   outer_point=superness[(x$r,y$$r),(x$$r,y$r)]; fi
  652.  z$l{corner-z$l}
  653.   ...superpull[superness[center,corner],outer_point]{z$$l-z$l}
  654.   ...{z$$l-corner}z$$l enddef;
  655.  
  656. vardef pulled_arc@#(suffix $,$$) =
  657.  pulled_super_arc@#($,$$)(superpull) enddef;
  658.  
  659. vardef serif_arc(suffix $,$$) =
  660.  z${x$$-x$,0}...(.75[x$,x$$],.25[y$,y$$]){z$$-z$}...{0,y$$-y$}z$$ enddef;
  661.  
  662. vardef penpos@#(expr b,d) =
  663.  if known b: if b<=0: errmessage "bad penpos"; fi fi
  664.  (x@#r-x@#l,y@#r-y@#l)=(b,0) rotated d;
  665.  x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef;
  666.  
  667. newinternal currentbreadth;
  668. vardef pos@#(expr b,d) =
  669.  if known b: if b<=currentbreadth: errmessage "bad pos"; fi fi
  670.  (x@#r-x@#l,y@#r-y@#l)=(b-currentbreadth,0) rotated d;
  671.  x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef;
  672. def numeric_pickup_ primary q =
  673.  currentpen:=pen_[q];
  674.  pen_lft:=pen_lft_[q];  pen_rt:=pen_rt_[q];
  675.  pen_top:=pen_top_[q];  pen_bot:=pen_bot_[q];
  676.  currentpen_path:=pen_path_[q];
  677.  if known breadth_[q]: currentbreadth:=breadth_[q]; fi enddef;
  678.  
  679. vardef ic# = charic enddef;
  680. vardef h# = charht enddef;
  681. vardef w# = charwd enddef;
  682. vardef d# = chardp enddef;
  683.  
  684. let {{=begingroup; let }}=endgroup;
  685. def .... = .. tension atleast .9 .. enddef;
  686. def less_tense = save ...; let ...=.... enddef;
  687. def ?? = hide(showvariable x,y) enddef;
  688.  
  689. let semi_ =;; let colon_ = :; let endchar_ = endchar;
  690. def iff expr b = if b:let next_=use_it else:let next_=lose_it fi; next_ enddef;
  691. def use_it = let : = restore_colon; enddef;
  692. def restore_colon = let : = colon_; enddef;
  693. def lose_it = let endchar=fi; inner cmchar; let ;=fix_ semi_ if false enddef;
  694. def fix_=let ;=semi_; let endchar=endchar_; outer cmchar; enddef;
  695. def always_iff = let : = endgroup; killboolean enddef;
  696. def killboolean text t = use_it enddef;
  697. outer cmchar;
  698.